home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / music / 7 / pascal / exampl.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-19  |  4.6 KB  |  152 lines
  1. {
  2. PROGRAM - COPY.PAS
  3.  
  4. PURPOSE - 1. Demo of Personal Pascal Printer, Disk, and Console I/O
  5.  
  6.           2. Do a reasonable job of printing files.
  7.  
  8. PROBLEMS - may be somewhat naive about screen control characters, like BS.
  9.  
  10. I took this example program and embellished it to do a little GEM.  Seems like
  11. hardly no one is doing pascal out there.  Like to change that!
  12.  
  13. Oh, please excuse the goto.  I is an old Fortran programmer, and don't know no
  14. better!
  15. }
  16.  
  17. program copy (input, output, input_file, output_file);
  18.  
  19. label 2;
  20.  
  21. const
  22.    {$I GEMCONST.PAS}
  23.  
  24. type
  25.    {$I GEMTYPE.PAS}
  26.    character = -1..127;
  27.  
  28. var
  29.    Alert_string, In_Name, Out_Name, Def_path: Str255;
  30.    Choice, Which : integer;
  31.    Dummy : char;
  32.    C : Character;
  33.    End_Line : Boolean;
  34.    Input_File, Output_File : File of Text;
  35.  
  36. {$I GEMSUBS}
  37.  
  38. function current_disk : integer;
  39. gemdos($19);
  40.  
  41. function getc (var c : character) : character;
  42. var
  43.   ch : char;
  44. begin
  45.   End_Line := eoln(input_file);
  46.   If not eof(input_file) then begin
  47.    read(input_file,ch);
  48.    c := ord(ch)
  49.   End;
  50.   getc := c
  51. end;
  52.  
  53. procedure putc(c : character);
  54. begin
  55.   if End_Line then
  56.    begin
  57.     writeln(output_file,chr(c));
  58.     End_Line := false;
  59.    end
  60.   else
  61.     write(output_file,chr(c));
  62. end;
  63.  
  64. begin
  65.  End_Line := false;
  66.  If INIT_GEM >= 0 then
  67.   begin
  68.    Alert_string := '[0][   The Copy Procedure |  |      From the book | ';
  69.    Alert_string := Concat(Alert_string, 'Software Tools in Pascal | ');
  70.    Alert_string := Concat(Alert_string, ' by Kernighan & Plauger ][ OK ]');
  71.    Choice := Do_alert(Alert_string,0);
  72.    Alert_string := '[0][  Modified for the ST  |     by The Vaxrat | ';
  73.    Alert_string := Concat(Alert_string, 'Parts c1986 OSS & CCD. | ');
  74.    Alert_string := Concat(Alert_string, ' Used with Permission | ]');
  75.    Alert_string := Concat(Alert_string, '[ Sure ]');
  76.    Choice := Do_alert(Alert_string,1);
  77.    Alert_string := '[0][   Call the Webbed Sphere!  |       (513) 299-3665 | ';
  78.    Alert_string := Concat(Alert_string,'300/1200 Baud 24 hrs a day | ');
  79.    Alert_string := Concat(Alert_string,'Tell Webby Vaxrat sent ya! | ]');
  80.    Alert_string := Concat(Alert_string,'[ Get on with it! ]');
  81.    Choice := Do_alert(Alert_string,1);
  82.    Alert_string := '[2][  |  Select Input Source  |  ]';
  83.    Alert_string := Concat(Alert_string, '[ Disk | Keys ]');
  84.    Choice := Do_alert(Alert_string,0);
  85.    If Choice = 1 then
  86.      Begin
  87.         IN_Name := '';
  88.         which := current_disk;
  89.         case which of
  90.          1 : Def_path := 'B:\*.TXT';
  91.          2 : Def_path := 'C:\*.TXT';
  92.          3 : Def_path := 'D:\*.TXT';
  93.          otherwise : Def_path := 'A:\*.TXT'
  94.         End;
  95.         If Not Get_in_file(Def_path, IN_Name) Then
  96.           GOTO 2;
  97.         Reset(Input_file, in_name);
  98.        end
  99.       else
  100.        Reset(Input_file, 'CON:');
  101.       Alert_string := '[0][ Select Output Source | ]';
  102.       Alert_string := Concat(Alert_string, '[ Disk | LPR | Mon ]');
  103.       Choice := Do_alert(Alert_string,0);
  104.       Case Choice of
  105.        1  :  Begin
  106.               If Not Get_Out_File('Output File Name?',Out_Name) Then
  107.                Goto 2;
  108.               Rewrite(Output_file,out_name)
  109.              End;
  110.        2  :  Begin
  111.               Out_Name := 'PRN:';
  112.               Alert_string := '[1][ Ready to Print! | Make sure that the |';
  113.               Alert_string := Concat(Alert_string,' Printer is Ready! ]');
  114.               Alert_string := Concat(Alert_string,'[ Ok | Abort ]');
  115.               Which := Do_alert(Alert_string,0);
  116.               If which = 2 then
  117.                Goto 2;
  118.               Rewrite(Output_file,out_name);
  119.               writeln(output_file,chr(27),chr(78),chr(6))
  120.              End;
  121.        3  :  Begin
  122.               Out_Name := 'CON:';
  123.               Alert_string := '[1][ Ready to Print! |  | Use Control-S/Q to |';
  124.               Alert_string := Concat(Alert_string,' Stop Scrolling. ]');
  125.               Alert_string := Concat(Alert_string,'[ Ok | Abort ]');
  126.               Which := Do_alert(Alert_string,0);
  127.               If which = 2 then
  128.                Goto 2;
  129.               Rewrite(Output_file,out_name);
  130.               Hide_Mouse;
  131.               Clear_Screen;
  132.              End
  133.     End
  134.   End;
  135.   while not eof(input_file) do
  136.    begin
  137.     c := getc(c);
  138.     putc(c)
  139.    end;
  140.   2 :Case Choice of
  141.     3 : Begin
  142.          Writeln(output_file);
  143.          Writeln('Press <RETURN> to continue...');
  144.          Read(dummy)
  145.         End;
  146.     2 : Writeln(Output_file,chr(12))
  147.     End;
  148.   Close(output_file);
  149.   Show_Mouse;
  150.   Exit_Gem
  151. End.
  152. əəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəə